home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / assemblr / re_ass / source85 / reass_85.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-22  |  51.8 KB  |  1,586 lines
  1. PROGRAM REASSEMBLER_8085;
  2. {$X+}
  3.  
  4. uses geminit,gem,tos,dos;
  5.  
  6. (* Programm zur Resassemblierung von INTEL 8080/85 Binärdateien *)
  7. (* Jens Schulz, Rosenstraße 5, D-25368 Kiebitzreihe             *)                               
  8. (* Programmiert in PurePascal 1.1                               *)
  9. (* Freeware 3/1994                                              *)
  10.  
  11. CONST  
  12.      DISASM85 =   0; (* Menuebaum *)
  13.      SHOWINFO =   9; (* STRING in Baum DISASM85 *)
  14.      LOADCODE =  18; (* STRING in Baum DISASM85 *)
  15.      SETADR   =  20; (* STRING in Baum DISASM85 *)
  16.      JUMPADR  =  21; (* STRING in Baum DISASM85 *)
  17.      ADRCODE  =  22; (* STRING in Baum DISASM85 *)
  18.      DISASM   =  24; (* STRING in Baum DISASM85 *)
  19.      QUIT     =  26; (* STRING in Baum DISASM85 *)
  20.      SET8080  =  28; (* STRING in Baum DISASM85 *)
  21.      SET8085  =  29; (* STRING in Baum DISASM85 *)
  22.      DISPOUT  =  31; (* STRING in Baum DISASM85 *)
  23.      PRTOUT   =  32; (* STRING in Baum DISASM85 *)
  24.      FILEOUT  =  33; (* STRING in Baum DISASM85 *)
  25.      LABLOAD  =  35; (* STRING in Baum DISASM85 *)
  26.      LABSAVE  =  36; (* STRING in Baum DISASM85 *)
  27.      LABCLEAR =  38; (* STRING in Baum DISASM85 *)
  28.  
  29.      INFOBOX  =   1; (* Formular/Dialog *)
  30.      EXITINFO =  15; (* BUTTON in Baum INFOBOX *)
  31.  
  32.      SETSTART =   2; (* Formular/Dialog *)
  33.      STARTADR =   4; (* FTEXT in Baum SETSTART *)
  34.      FILEOFFSET = 5; (* FTEXT in Baum SETSTART *)
  35.      ENDADR   =   6; (* FTEXT in Baum SETSTART *)
  36.  
  37.      JMPADDR  =   3; (* Formular/Dialog *)
  38.      JADDRESS =   4; (* FTEXT in Baum JMPADDR *)
  39.      JUMP     =   5; (* BUTTON in Baum JMPADDR *)
  40.  
  41.      Resourcefile = 'REASS_85.RSC';               (* Resource-Name       *)
  42.      Maxram       = 8192;                         (* max. 8 KB Code      *)
  43.              
  44. TYPE STRG50  = String[50];                        (* Befehlsstring       *)
  45.      Hexa    = String[4];                         (* Hex-string          *)
  46.      DirStr  = String[105];                       (* Datei-Angaben       *)
  47.      NameStr = String[8];
  48.      ExtStr  = String[4];
  49.      Pfad    = String[128];     
  50.      GRECT   = record                             (* für RC_INTERSECT    *)
  51.                     g_x,g_y,g_w,g_h: integer;
  52.        END; 
  53.        Reasmline = record                           (* Befehlszeile        *)
  54.           Befehl : STRG50;
  55.           Adr    : WORD;
  56.        END;
  57.           
  58. VAR 
  59.  
  60.      Disasmline   : STRG50;                        (* Befehlzeile        *)
  61.      M            : ARRAY[0..255] OF String[12];   (* Mnemonics          *)
  62.      Codefield    : ARRAY[0..MAXRAM] OF BYTE;      (* Feld für Code      *)
  63.      Labelfield   : ARRAY[0..65535] OF BYTE;       (* Labelmarkierung    *)
  64.      Disasmfield  : ARRAY[0..MAXRAM] OF Reasmline; (* Befehlsfeld        *)
  65.      proztype     : Hexa;
  66.      Codefile     : FILE OF BYTE;   
  67.  
  68.      ap_id, error : integer;          (* GEM-Idnr.                       *)
  69.      tree,mtree   : pointer;          (* Zeiger auf Formulare, Menü      *)
  70.      screen_buffer: pointer;          (* Hintergrundspeicher für Fenster *)
  71.      bufferlen    : longint;          (* Hintergrundspeicher-Länge       *)
  72.        work_in      :    workin_array;     (* GEM-Arrays                      *)
  73.        work_out     :    workout_array;
  74.        
  75.      psrcMFDB, pdesMFDB : MFDB;       (* MFDB-Records für VDI 109        *)
  76.      scrnMFDB, buffMFDB : MFDB;       (* MFDB-Records Screen und Buffer  *)
  77.      
  78.      startlen     : word;             (* Länge des reasm. Codes    *)
  79.      d_nr         : word;             (* Befehlszeilen-Zähler      *)
  80.      act_d_nr     : word;             (* Aktuelle Startzeile       *)
  81.      number_lines : word;             (* Anzahl Zeilen im Fenster  *)
  82.        Codestart    : word;             (* ORG-Adresse               *)
  83.        Filelength   : word;             (* Größe der Binärdatei      *)
  84.        file_offset  : word;             (* Offset vom Dateianfang    *)
  85.        
  86.        whandle      :    integer;            (* Window-Handle             *)
  87.        max_x,max_y  :    integer;            (* größte x bzw y Koordinate *)
  88.        x,y,w,h      :    integer;            (* Fenstergröße              *)
  89.      button       : integer;          (* Alert-Button              *)
  90.      key          : integer;          (* Event-Taste               *)
  91.      nachr        : integer;          (* Event-Ergebnis            *)
  92.      typ_nachricht: integer;          (* Event-Art                 *)
  93.      show_mode    : byte;             (* Adresseneinblendung       *)
  94.        path         : String;           (* Pfadname                  *)
  95.        title        :    String[60];         (* Titelzeile für Fenster    *)
  96.        winfo        : String[60];       (* Infozeile für Fenster     *)
  97.      lab_clr      : boolean;          (* Label autom. löschen      *)
  98.      ENDE         : boolean;          (* Abbruch per Closer        *)
  99.           
  100. (****************** Proceduren / Funktionen **************************)
  101.                        
  102. function max(a,b:integer):integer;    
  103. (*Maximum zweier Integerwerte ermitteln*)
  104.  
  105. BEGIN
  106.     if a>b then max:=a else max:=b
  107. END;
  108.  
  109. function min(a,b:integer):integer;    
  110.  
  111. (*Minimum zweier Integerwerte ermitteln*)
  112. BEGIN
  113.     if a<b then min:=a else min:=b
  114. END;
  115.  
  116. function hiword(wert:pointer):word;    (*Highword eines Pointers ermitteln*)
  117. BEGIN
  118.     hiword:=longint(wert) div 65536;
  119. END;
  120.  
  121. function loword(wert:pointer):word;    (*Lowword eines Pointers ermitteln*)
  122. BEGIN
  123.     loword:=longint(wert) mod 65536;
  124. END;
  125.  
  126. procedure mouse_on;                        (* Maus an *)
  127. BEGIN
  128.     graf_mouse( M_ON, NIL );
  129. END;
  130.  
  131. procedure mouse_off;                       (* Maus aus *)
  132. BEGIN
  133.     graf_mouse( M_OFF, NIL );
  134. END;
  135.  
  136. (********************** Anzahl Bitplanes holen *************************)
  137.  
  138. FUNCTION get_bitplanes:integer;  (* Stelt die Anzahl der Bitplanes fest *)
  139.  
  140. VAR testout:Workout_array;
  141.  
  142. BEGIN
  143.   vq_extnd(vdiHandle,1,testout);
  144.   get_bitplanes := testout[4];    (* Bitplaneanzahl steht im 4. Feld *)
  145. END;
  146.  
  147. (************************** Dialogbehandlung *****************************)
  148.  
  149. FUNCTION get_obj_state(t : aestreeptr; o : integer) : integer;
  150. BEGIN
  151.     (* Ermittel Status eines Objektes *)
  152.     get_obj_state:=t^[o].ob_state;
  153. END;
  154.  
  155. PROCEDURE set_obj_state(t : aestreeptr; o, s : integer);
  156. BEGIN
  157.     (* Ändert Status eines Objektes *)
  158.     t^[o].ob_state:=s;
  159. END;
  160.  
  161. (********************** Dialog aufrufen **********************************)
  162.  
  163. FUNCTION hndl_form(obj: integer) : integer;
  164.  
  165.     (* Stellt Dialogbox dar und gibt den gedrückten Knopf zurück.*)
  166.  
  167. VAR    answer  : integer;
  168.         x, y, w, h : integer;
  169.  
  170.     PROCEDURE hide_form(obj:integer);
  171.     (* Löscht Formular vom Bildschirm *)
  172.     BEGIN
  173.         form_center(tree, x, y, w, h);
  174.         form_dial(FMD_FINISH, x, y, w, h, x, y, w, h);
  175.     END;
  176.  
  177.     PROCEDURE show_form(obj:integer);
  178.     (* Zeichnet Formular *)
  179.     BEGIN
  180.         form_center(tree, x, y, w, h);
  181.         form_dial(FMD_START, x, y, w, h, x, y, w, h);
  182.         objc_draw(tree, 0, max_depth, x, y, w, h);
  183.     END;
  184.  
  185. BEGIN
  186.     rsrc_gaddr(R_TREE, obj, tree);   (* Adresse des Formulars ermitteln *)
  187.     graf_mouse( M_OFF, NIL );        (* Maus vor Zeichnen ausschalten   *)
  188.     show_form(obj); 
  189.     graf_mouse( M_ON, NIL );         (* Maus wieder einschalten         *)
  190.     answer := form_do(tree, 0);      (* Dialog dem GEM überlassen       *)
  191.     hide_form(obj);                  (* weg mit der Box                 *)
  192.                                      (* Exit-Button wieder deselekt.    *)
  193.     set_obj_state(tree,answer,get_obj_state(tree, answer) and (not selected));
  194.     hndl_form:=answer;    
  195. END;
  196.  
  197. (*************************** 16-bit Hex-Adresse erzeugen ****************)
  198.  
  199. PROCEDURE Makehexadr(VAR hexvalue:Hexa;VAR PC:word);
  200.  
  201. {Hexadresse als String erzeugen}
  202. VAR ZwischenPC:word;
  203.     DivPC     :word;
  204.     Zw1,Zw2,i :word;
  205.  
  206. BEGIN
  207.   ZwischenPC := PC;
  208.   DivPC := 4096;
  209.   FOR i :=1 TO 4 DO
  210.   BEGIN
  211.     Zw1 := ZwischenPC DIV DivPC;
  212.     Zw2 := ZwischenPC MOD DivPC;
  213.     DivPC := DivPC DIV 16;
  214.     hexvalue[i] := chr(Zw1);
  215.     IF ord(hexvalue[i]) <= 9 THEN
  216.     BEGIN
  217.       hexvalue[i] := chr(Zw1+48);
  218.     END
  219.     ELSE
  220.     BEGIN
  221.       hexvalue[i] := chr(Zw1+55);
  222.     END;
  223.     ZwischenPC := Zw2;
  224.   END;
  225.   hexvalue[0] := chr(4);
  226. END;
  227.  
  228. (******************* Label-Routine für Reassembler *********************)
  229.  
  230. Procedure Set_Label(i:integer);   (* Setzt Label ein *)
  231.  
  232. VAR hexvalue:Hexa;
  233.  
  234. BEGIN
  235.     IF Labelfield[Disasmfield[i].adr] = 1 THEN
  236.     BEGIN
  237.        IF show_mode = 1 THEN
  238.        BEGIN
  239.        Disasmfield[i].befehl[11] := 'L';
  240.        Disasmfield[i].befehl[12] := Disasmfield[i].befehl[3];
  241.        Disasmfield[i].befehl[13] := Disasmfield[i].befehl[4];
  242.        Disasmfield[i].befehl[14] := Disasmfield[i].befehl[5];
  243.        Disasmfield[i].befehl[15] := Disasmfield[i].befehl[6];
  244.        Disasmfield[i].befehl[16] := ':';
  245.      END
  246.      ELSE
  247.      BEGIN
  248.        Makehexadr(hexvalue,Disasmfield[i].adr);
  249.        Disasmfield[i].befehl[2] := 'L';
  250.        Disasmfield[i].befehl[3] := hexvalue[1];
  251.        Disasmfield[i].befehl[4] := hexvalue[2];
  252.        Disasmfield[i].befehl[5] := hexvalue[3];
  253.        Disasmfield[i].befehl[6] := hexvalue[4];
  254.        Disasmfield[i].befehl[7] := ':';
  255.      END;
  256.   END;
  257. END;  
  258.  
  259. (**********************************************************************)
  260.  
  261. procedure set_label_color(i:integer);   (* Label rot drucken    *)
  262.                                         (* Absolutziele schwarz *)
  263. BEGIN
  264.     IF Labelfield[Disasmfield[i].adr] = 1 THEN
  265.     BEGIN
  266.       vst_color(vdiHandle,Red);
  267.     END
  268.     ELSE
  269.     BEGIN
  270.       IF Labelfield[Disasmfield[i].adr] = 2 THEN
  271.       BEGIN
  272.         vst_color(vdiHandle,Black);    
  273.       END;
  274.     END;       
  275. END;
  276.  
  277. (*************************** MFDB VDI 109 definieren ******************)
  278.  
  279. procedure Set_MFDB; (* Setzen der MFDB-Blöcke für VDI 109 *)
  280.  
  281. VAR xw,yw,bw,hw : integer;
  282.  
  283. BEGIN
  284.   wind_get(0,WF_WORKXYWH,xw,yw,bw,hw);    (* Bildgröße holen *)
  285.     scrnMFDB.fd_addr := NIL;                (* Bildschirm-MFDB *)
  286.     scrnMFDB.fd_w := bw;
  287.     scrnMFDB.fd_h := hw;
  288.     scrnMFDB.fd_wdwidth := bw div 16;
  289.     scrnMFDB.fd_stand := 0;
  290.     scrnMFDB.fd_nplanes:=get_bitplanes;     (* Farbtiefe in Planes *)
  291.  
  292.      wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  293.     buffMFDB.fd_addr := screen_buffer;  (* screen_buffer-MFDB *)
  294.     buffMFDB.fd_w := 400;
  295.     buffMFDB.fd_h := hw;
  296.     buffMFDB.fd_wdwidth := 25;;  (* 25 Worte Breite = 400/16 *)
  297.     buffMFDB.fd_stand:= 0;
  298.     buffMFDB.fd_nplanes:=get_bitplanes;    
  299. END;
  300.  
  301. (************************** Fenster sichern ****************************)
  302.  
  303. Procedure save_window;  (* Sichern des Fensterinhaltes in screenbuffer *)
  304.  
  305. VAR pxyarray    : ARRAY_8;
  306.     xw,yw,bw,hw : integer;
  307. BEGIN
  308.     psrcMFDB := scrnMFDB;     (* MFDB-Blöcke übernehmen             *)
  309.     pdesMFDB := buffMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
  310.     
  311.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    (* Arbeitsfläche holen *)
  312.     pxyarray[0] := xw; 
  313.     pxyarray[1] := yw;
  314.     pxyarray[2] := xw+bw;
  315.     pxyarray[3] := yw+hw;
  316.     pxyarray[4] := 0;
  317.     pxyarray[5] := 0;
  318.     pxyarray[6] := bw;
  319.     pxyarray[7] := hw;                        
  320.   mouse_off;
  321.   vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  322.   mouse_on;
  323. END;    
  324.  
  325. (************************* Fensterteile restaurieren ****************)
  326.  
  327. Procedure restore_window(clip:Array_4);  (* Restaurieren des Fensterinhaltes *)
  328.  
  329. VAR xw,yw,bw,hw: INTEGER;
  330.     pxyarray   : ARRAY_8;
  331.     
  332. BEGIN
  333.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  334.     psrcMFDB := buffMFDB;     (* MFDB-Blöcke übernehmen             *)
  335.     pdesMFDB := scrnMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
  336.     pxyarray[0] := clip[0]-xw;
  337.     pxyarray[1] := clip[1]-yw;
  338.     pxyarray[2] := clip[2]-xw;
  339.     pxyarray[3] := clip[3]-yw;                        
  340.     pxyarray[4] := clip[0]; 
  341.     pxyarray[5] := clip[1];
  342.     pxyarray[6] := clip[2];
  343.     pxyarray[7] := clip[3];
  344.   vro_cpyfm(vdiHandle,3,pxyarray,psrcMFDB,pdesMFDB); (* VDI 109 *)
  345. END;    
  346.  
  347. (*************************** Fenster säubern ***************************)
  348.  
  349. PROCEDURE Clear_Window;
  350.  
  351. VAR xw, yw, bw, hw : integer;
  352.     pxyarray : ARRAY_4;
  353.     
  354. BEGIN
  355.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw); (* Arbeitsfläche holen *)
  356.     vsf_color(vdiHandle,White);
  357.     vsf_interior(vdiHandle,FIS_SOLID);
  358.     vsf_perimeter(vdiHandle,0);
  359.     pxyarray[0] := xw;
  360.         pxyarray[1] := yw;
  361.         pxyarray[2] := xw+bw-1;
  362.         pxyarray[3] := yw+hw-1;
  363.     mouse_off;
  364.     v_bar(vdiHandle,pxyarray);                 (* Fenster weiß füllen *)
  365.     mouse_on;  
  366.     save_window;
  367. END;
  368.  
  369. (**************************** Fenster öffnen ***************************)
  370.  
  371. procedure open_window;    (*Fenster öffnen*)
  372.  
  373. var    wx,wy,wb,wh : integer;
  374.     
  375. BEGIN
  376.       wind_get(0,WF_WORKXYWH,    wx, wy, wb, wh);   (* Größe Bildschirm in Pixel *)
  377.       max_x := wb;
  378.       max_y := wh;
  379.         whandle:=wind_create(NAME or CLOSER or MOVER or VSLIDE or INFO or
  380.                               UPARROW or DNARROW or SIZER or LFARROW or
  381.                               RTARROW,((wb-400) div 2),0,400,max_y);
  382.         if whandle<=0 then
  383.               exit;
  384.         title :=' Reassembler INTEL 8080/85 '#0;
  385.         winfo :='   Adresse  Label   Code      Mnemonics'#0;
  386.         wind_set(whandle,WF_NAME,hiword(@title[1]),loword(@title[1]),0,0);
  387.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
  388.         mouse_off;
  389.         wind_open(whandle,((wb-400) div 2),wy,400,max_y); (* Fenster aufmachen *)
  390.     Set_MFDB;         (* MFDB initialisieren     *)
  391.     Clear_window;     (* Fenster mit weiß füllen *)
  392.         mouse_on;
  393. END;
  394.  
  395. (************************ Zeilen-Scrolling *****************************)
  396.  
  397. procedure scroll_line_down;  (* Pfeil nach unten geklickt *)
  398.  
  399. VAR pxyarray    : ARRAY_8;
  400.     pxyarray1   : ARRAY_4;
  401.     xw,yw,bw,hw : integer;
  402.     slider_pos  : integer;    
  403.  
  404. BEGIN
  405.   IF act_d_nr < (d_nr - number_lines + 1 ) THEN
  406.   BEGIN
  407.       psrcMFDB := buffMFDB;     (* MFDB-Blöcke übernehmen             *)
  408.       pdesMFDB := scrnMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
  409.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  410.       pxyarray[0] := 0; 
  411.       pxyarray[1] := 16;
  412.       pxyarray[2] := bw;
  413.       pxyarray[3] := hw-2;
  414.       pxyarray[4] := xw;
  415.       pxyarray[5] := yw;
  416.       pxyarray[6] := xw+bw;
  417.       pxyarray[7] := yw+hw-2;                        
  418.     mouse_off;
  419.     wind_set(whandle,WF_TOP,0,0,0,0); (* für MultiTOS nach vorn *)
  420.     vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  421.     pxyarray1[0] := xw;
  422.       pxyarray1[1] := yw+hw-17;     (* untere Zeile löschen *)
  423.       pxyarray1[2] := xw+bw-1;
  424.       pxyarray1[3] := yw+hw-1;
  425.     v_bar(vdiHandle,pxyarray1);
  426.     inc(act_d_nr);
  427.     vst_color(vdiHandle,Blue);             (* Befehl drucken *)
  428.       Set_label_color(act_d_nr+number_lines-2);
  429.       v_gtext(vdiHandle,xw,yw+16*(number_lines-1),'  '+Disasmfield[act_d_nr+number_lines-2].befehl);    
  430.     vst_color(vdiHandle,Black);
  431.     slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
  432.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
  433.     save_window;
  434.     mouse_on;
  435.   END;  
  436. END;
  437.  
  438. procedure scroll_line_up;   (* Pfeil nach oben geklickt *)
  439.  
  440. VAR pxyarray    : ARRAY_8;
  441.     pxyarray1   : ARRAY_4;
  442.     xw,yw,bw,hw : integer;
  443.     slider_pos  : integer;
  444.  
  445. BEGIN
  446.   IF act_d_nr > 1 THEN
  447.   BEGIN
  448.       psrcMFDB := buffMFDB;     (* MFDB-Blöcke übernehmen             *)
  449.       pdesMFDB := scrnMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
  450.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  451.       pxyarray[0] := 0; 
  452.       pxyarray[1] := 0;
  453.       pxyarray[2] := bw;
  454.       pxyarray[3] := hw-15;
  455.       pxyarray[4] := xw;
  456.       pxyarray[5] := yw+16;
  457.       pxyarray[6] := xw+bw;
  458.       pxyarray[7] := yw+hw-15;                        
  459.     mouse_off;
  460.     wind_set(whandle,WF_TOP,0,0,0,0);  (* für MultiTOS *)
  461.     vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  462.     pxyarray1[0] := xw;
  463.       pxyarray1[1] := yw;           (* obere Zeile löschen *)
  464.       pxyarray1[2] := xw+bw-1;
  465.       pxyarray1[3] := yw+16;
  466.     v_bar(vdiHandle,pxyarray1);
  467.     dec(act_d_nr);
  468.     vst_color(vdiHandle,Blue);    (* Befehl drucken *)
  469.       Set_label_color(act_d_nr);
  470.       v_gtext(vdiHandle,xw,yw+16,'  '+Disasmfield[act_d_nr].befehl);    
  471.     vst_color(vdiHandle,Black);
  472.     slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
  473.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
  474.     save_window;     
  475.     mouse_on;
  476.   END;  
  477. END;
  478.  
  479. (*************************** Slider-Verschiebung setzen ****************)
  480.  
  481.  
  482. Procedure Slider_move(slider_pos:integer);   (* Slider-Scrolling *)
  483.  
  484. VAR i,xw,yw,bw,hw : integer;
  485.     start_x,start_y : integer;
  486.     slider_v : real;
  487.     
  488. BEGIN
  489.   wind_set(whandle,WF_TOP,0,0,0,0);
  490.   IF (d_nr >= number_lines-1) and (slider_pos > 0) THEN
  491.   BEGIN
  492.     act_d_nr := d_nr-number_lines;
  493.     slider_v := slider_pos/1000+0.00001;
  494.     act_d_nr := trunc(slider_v * act_d_nr)+1;
  495.     IF act_d_nr < 1 THEN
  496.     BEGIN
  497.       act_d_nr := 1;
  498.     END;  
  499.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
  500.   END
  501.   ELSE
  502.   BEGIN
  503.     act_d_nr := 1;
  504.     wind_set(whandle,WF_VSLIDE,0,0,0,0);
  505.   END;
  506.   Clear_Window;
  507.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);  
  508.     i := act_d_nr;
  509.     start_x := xw +16;
  510.     start_y := yw + 16;
  511.   vst_color(vdiHandle,Blue);
  512.     WHILE (i <= d_nr) and (start_y <= yw + hw) DO  (* Befehle drucken *)
  513.   BEGIN
  514.      Set_label_color(i);
  515.      v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  516.      inc(i);
  517.      start_y := start_y + 16;
  518.        vst_color(vdiHandle,Blue);
  519.   END;  
  520.   vst_color(vdiHandle,Black);
  521.   save_window;
  522. END;
  523.  
  524. (*************** rc_intersect für Fenster-Redraw ***********************)
  525.  
  526. function rc_intersect(var r1,r2: GRECT): boolean;    
  527.  
  528. var    x,y,w,h:    integer;
  529.  
  530. BEGIN
  531.     x:=max(r2.g_x,r1.g_x);
  532.     y:=max(r2.g_y,r1.g_y);
  533.     w:=min(r2.g_x+r2.g_w,r1.g_x+r1.g_w);
  534.     h:=min(r2.g_y+r2.g_h,r1.g_y+r1.g_h);
  535.     r2.g_x:=x;
  536.     r2.g_y:=y;
  537.     r2.g_w:=w-x;
  538.     r2.g_h:=h-y;
  539.     if (w>x) and (h>y) then
  540.         rc_intersect:=true
  541.     else
  542.         rc_intersect:=false;
  543. END;
  544.  
  545. (********************* Redrawroutine für Reassembler-Fenster **********)
  546.  
  547. procedure redrawwindow;
  548.  
  549. var    box,work : GRECT;
  550.       clip     : Array_4;
  551.     pxyarray : Array_4;
  552.  
  553. BEGIN
  554.   mouse_off;
  555.   wind_update(BEG_UPDATE);
  556.     if whandle<=0 then
  557.         exit;
  558.     wind_get(whandle,WF_WORKXYWH,work.g_x,work.g_y,work.g_w,work.g_h);
  559.     wind_get(whandle,WF_FIRSTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
  560.     while (box.g_w>0) and (box.g_h>0) do
  561.     BEGIN
  562.         if rc_intersect(work,box) then
  563.         BEGIN
  564.             clip[0]:=box.g_x; clip[1]:=box.g_y;
  565.             clip[2]:=box.g_x+box.g_w-1; clip[3]:=box.g_y+box.g_h-1;
  566.             vs_clip(vdiHandle,1,clip);
  567.       restore_window(clip);
  568.         END;
  569.         wind_get(whandle,WF_NEXTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
  570.     END;
  571.     wind_update(END_UPDATE);
  572.   mouse_on;
  573. END;
  574.  
  575. (************************************************************************)
  576.  
  577. Procedure Hex_in_Word(VAR start:WORD;hexstr:Hexa);  
  578.  
  579. VAR i,divfaktor: word;  (* 4-stellig Hex in Word-Format *)
  580.     hex : ARRAY[1..4] OF byte;
  581.     
  582. BEGIN
  583.   start := 0;
  584.   divfaktor := 4096;
  585.   WHILE length(hexstr) < 4 DO
  586.   BEGIN
  587.     hexstr := '0'+hexstr;
  588.   END;   
  589.   FOR i := 1 TO 4 DO
  590.   BEGIN
  591.     IF hexstr[i] <= '9' THEN
  592.     BEGIN
  593.       hex[i] := ord(hexstr[i])-48;     (* 0 - 9 *)
  594.     END
  595.     ELSE        
  596.     BEGIN
  597.       IF upcase(hexstr[i]) <= 'F' THEN
  598.       BEGIN
  599.         hex[i] := ord(upcase(hexstr[i]))-55;   (* A - F *)
  600.       END;
  601.     END;
  602.     start := start + hex[i]*divfaktor;
  603.     divfaktor := divfaktor DIV 16;
  604.   END;
  605. END;    
  606.  
  607. (**************************** File-Selector ****************************)
  608.  
  609.  
  610. Procedure SelectFile(VAR selectname:pfad;ext:Extstr);         
  611.  
  612. VAR
  613.   filename   : String;              (* Pfad-/Dateinamen *)
  614.     dir        : DirStr;     
  615.     name       : NameStr;
  616.     exitButton : Integer;
  617.     path1      : String;
  618.     
  619. BEGIN
  620.  
  621.   path1 := concat(path,ext);
  622.     filename := '';
  623.     name := '';
  624.     fsel_input( path1, filename, exitButton );  (* File_Selector aufrufen *)
  625.     IF exitButton = 0 then
  626.         selectname := ''
  627.     ELSE
  628.     BEGIN
  629.         FSplit( path1, dir, name, ext );     (* Pfad zerlegen *)
  630.         selectname := dir + filename;
  631.         path := concat(dir,'*.');
  632.     END;
  633. END;
  634.  
  635. (**************************** Binärcode laden *************************)
  636.  
  637. PROCEDURE Laden;
  638.  
  639. VAR name    : pfad; 
  640.     len_str : string[4];
  641.  
  642. { Laden eines Binärfiles von der Diskette
  643.   Dateigröße ist durch Maxram begrenzt
  644.   Datei vom Typ FILE OF BYTE }
  645.  
  646. BEGIN
  647.   SelectFile(name,'BIN');
  648.   IF name <> '' THEN
  649.   BEGIN
  650.     d_nr := 1;
  651.     act_d_nr := 1;
  652.     ASSIGN(Codefile,name);              (* Datei zuordnen *)
  653.     RESET(Codefile);
  654.     filelength := FileSize(Codefile);   (* Dateigröße holen *)
  655.     IF (filelength <= MAXRAM) THEN
  656.     BEGIN
  657.       blockread(Codefile,Codefield,filelength); (* Datei komplett laden *)
  658.       rsrc_gaddr(R_TREE, SETSTART, tree);       (* Dialog Adresse       *)   
  659.       IF (filelength < 10) THEN
  660.       BEGIN
  661.         str(filelength:1,len_str);
  662.       END;
  663.       IF (filelength >= 10) and (filelength < 100) THEN
  664.       BEGIN
  665.         str(filelength:2,len_str);
  666.       END;      
  667.       IF (filelength >= 100) and (filelength < 1000) THEN
  668.       BEGIN
  669.         str(filelength:3,len_str);
  670.       END;      
  671.       IF (filelength >= 1000) THEN
  672.       BEGIN
  673.         str(filelength:4,len_str);
  674.       END;
  675.       SetPtext(tree,ENDADR,len_str);  (* Dateilänge in Dialog einsetzen *) 
  676.       startlen := filelength;        
  677.       Clear_Window;
  678.       wind_set(whandle,WF_VSLIDE,0,0,0,0); 
  679.       close(codefile);
  680.     END
  681.     ELSE
  682.     BEGIN
  683.       form_alert(1,'[1][ Datei ist größer | als 8192 Bytes ! ][ Schade ]');
  684.       close(codefile);
  685.     END;
  686.   END;  
  687. END;
  688.  
  689. (*************************** 8-bit Hexwert erzeugen *********************)
  690.  
  691. PROCEDURE Makehexbyte(VAR hexvalue:Hexa;Cbyte:byte);
  692.  
  693. {Hexbyte als String erzeugen}
  694. VAR
  695.     DivPC     :byte;
  696.     Zw1,Zw2,i :byte;
  697.  
  698. BEGIN
  699.   DivPC := 16;
  700.   FOR i :=1 TO 2 DO
  701.   BEGIN
  702.     Zw1 := CByte DIV DivPC;
  703.     Zw2 := CByte MOD DivPC;
  704.     DivPC := DivPC DIV 16;
  705.     hexvalue[i] := chr(Zw1);
  706.     IF ord(hexvalue[i]) <= 9 THEN
  707.     BEGIN
  708.       hexvalue[i] := chr(Zw1+48);
  709.     END
  710.     ELSE
  711.     BEGIN
  712.       hexvalue[i] := chr(Zw1+55);
  713.     END;
  714.     CByte := Zw2;
  715.   END;
  716.   hexvalue[0] := chr(2);
  717. END;
  718.  
  719. (********************* Befehl zusammensetzen *************************)
  720.  
  721. PROCEDURE GETINSTRUCTION(VAR Instcode:STRG50;VAR PC:word);
  722.  
  723. VAR
  724. Codebyte : byte;
  725. Abs_adr  : word;
  726. Codename,name2 : STRING[18];
  727. Codechar : CHAR;
  728. Hexbyte  : Hexa;
  729. Hexbyt2  : Hexa;
  730.  
  731. BEGIN
  732.   Codebyte := Codefield[PC+file_offset];
  733.   Codename := M[Codebyte];
  734.   Codechar := Codename[1];
  735.   Makehexbyte(Hexbyte,Codebyte);
  736.   Instcode := concat(Hexbyte,' ');
  737.   CASE Codechar OF
  738.     '0' : BEGIN    {Implied Adressierung}
  739.             Name2 := copy(Codename,2,length(Codename)-1);
  740.             Instcode := Concat(Instcode,'       ',Name2);
  741.           END;
  742.     '1' : BEGIN    {Absolute Adressierung}
  743.             IF Labelfield[PC+Codestart] <> 1 THEN
  744.             BEGIN
  745.                Labelfield[PC+Codestart] := 2;  (* Absolut-Adresse markieren *)  
  746.             END;     
  747.             Inc(PC);
  748.             Codebyte := Codefield[PC+file_offset];            
  749.             Abs_adr := Codebyte + 256 * Codefield[PC+1+file_offset];
  750.             Labelfield[Abs_Adr] := 1;       (* Label markieren *)
  751.             Makehexbyte(Hexbyt2,Codebyte);
  752.             Inc(PC); 
  753.             Codebyte := Codefield[PC+file_offset];
  754.             Makehexbyte(Hexbyte,Codebyte);
  755.             Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
  756.             Name2 := copy(Codename,2,length(Codename)-1);
  757.             Instcode := Concat(Instcode,Name2);
  758.             Instcode := Concat(Instcode,'L',hexbyte,hexbyt2);
  759.           END;
  760.     '2' : BEGIN     {Immediate Adressierung}
  761.             Inc(PC);
  762.             Codebyte := Codefield[PC+file_offset];
  763.             Makehexbyte(Hexbyte,Codebyte);
  764.             Instcode := Concat(Instcode,Hexbyte,'     ');
  765.             Name2 := copy(Codename,2,length(Codename)-1);
  766.             Instcode := Concat(Instcode,Name2);
  767.             IF hexbyte[1] > '9' THEN
  768.             BEGIN
  769.               Instcode := Concat(Instcode,'0');
  770.             END;
  771.             Instcode := Concat(Instcode,Hexbyte,'H');
  772.           END;
  773.     '3' : BEGIN      {16-bit Immediate-Adressierung}
  774.             Inc(PC);
  775.             Codebyte := Codefield[PC+file_offset];
  776.             Makehexbyte(Hexbyt2,Codebyte);
  777.             Inc(PC);
  778.             Codebyte := Codefield[PC+file_offset];
  779.             Makehexbyte(Hexbyte,Codebyte);
  780.             Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
  781.             Name2 := copy(Codename,2,length(Codename)-1);
  782.             Instcode := Concat(Instcode,Name2);
  783.             IF hexbyte[1] > '9' THEN
  784.             BEGIN
  785.               Instcode := Concat(Instcode,'0');
  786.             END;   
  787.             Instcode := Concat(Instcode,hexbyte,hexbyt2,'H');
  788.           END;
  789.     '4' : BEGIN       {Unbekannter Code als DATA ausgeben}
  790.             Name2 := copy(Codename,2,length(Codename)-1);
  791.             Instcode := Concat(Instcode,'       ',Name2);
  792.             IF hexbyte[1] > '9' THEN
  793.             BEGIN
  794.               Instcode := Concat(Instcode,'0');
  795.             END;
  796.             Instcode := Concat(Instcode,hexbyte,'H');
  797.           END;
  798.      END;
  799.      Inc(PC);
  800. END;
  801.  
  802. (*********************** Befehl + Adresse montieren ********************)
  803.  
  804. PROCEDURE BEFEHL(VAR Mnemonic:STRG50;VAR PC:word);
  805.  
  806. VAR
  807. Hexadr : Hexa;
  808. Inst   : STRG50;
  809. tempPC : word;
  810.  
  811. { Mnemonic enthält beim Verlassen der Procedure den Vollständigen Befehl }
  812.  
  813. BEGIN
  814.   Inst := '';
  815.   tempPC := PC + codestart;
  816.   Makehexadr(Hexadr,tempPC);
  817.   Mnemonic := Concat(' $',Hexadr,'            ');
  818.   Getinstruction(Inst,PC);
  819.   Mnemonic := Concat(Mnemonic,Inst);
  820. END;
  821.  
  822. (********************** Reassembler-Aufruf ******************************)
  823.  
  824. Procedure Display;
  825.  
  826. VAR PC                : word;
  827.     xw, yw, bw, hw    : integer;
  828.     start_x, start_y  : integer;
  829.     start_pc,tempPC   : word;
  830.     clip              : ARRAY_4;
  831.     Labelstr          : String[6];
  832.     i                 : word;
  833.     
  834. BEGIN
  835.   IF Filelength <> 0 THEN
  836.   BEGIN
  837.     PC := 0;
  838.     menu_icheck(mtree,FILEOUT,0);  (* Dateihäkchen aus      *)
  839.     menu_icheck(mtree,PRTOUT,0);   (* Druckerhäkchen aus    *)    
  840.     menu_icheck(mtree,DISPOUT,1);  (* Bildschirmhäkchen an  *)  
  841.       IF file_offset > filelength THEN
  842.       BEGIN
  843.       form_alert(1,'[1][ File-Offset > Dateilänge ! | Offset wird 0 gesetzt ][ Hmmh ]');
  844.       rsrc_gaddr(R_TREE, SETSTART, tree);  (* Dialogadresse holen  *)
  845.       SetPtext(tree,FILEOFFSET,'0000');  
  846.         file_offset := 0;
  847.       END;  
  848.       wind_set(whandle,WF_VSLIDE,0,0,0,0);
  849.       Clear_window;                               (* Fenster säubern *)
  850.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  851.       clip[0]:= xw; clip[1]:=yw;
  852.         clip[2]:= xw+bw-1; clip[3]:= yw+hw-1;
  853.         vs_clip(vdiHandle,1,clip); 
  854.       start_x := xw + 16;
  855.       start_y := yw + 16;
  856.       Clear_Window;
  857.       v_gtext(vdiHandle,start_x,start_y,'Reassembler läuft..., bitte warten');
  858.       v_gtext(vdiHandle,start_x,start_y+16,'       Motorola 680xx for ever');
  859.     FOR i:=1 To filelength+1 DO
  860.     BEGIN
  861.         Disasmfield[i].adr := 0;       (* Befehls-Array löschen *)
  862.         Disasmfield[i].befehl := '';
  863.     END;
  864.     IF lab_clr THEN           (* Labelarray automatisch löschen ? *)
  865.     BEGIN
  866.       FOR i:= 0 TO 65535 DO
  867.       BEGIN
  868.         Labelfield[i] := 0; (* Labelfeld löschen *)
  869.       END;
  870.     END;  
  871.       d_nr := 1;
  872.       act_d_nr := 1;
  873.     Start_PC := PC + Codestart;          (* Startadresse merken           *)
  874.       WHILE (PC+codestart <= 65535) and (PC+codestart <= start_pc+startlen) DO      
  875.       BEGIN
  876.         tempPC := PC + codestart;
  877.         Disasmfield[d_nr].adr := tempPC;    (* Befehlsmontage, Hauptschleife *)
  878.         BEFEHL(Disasmline,PC);
  879.       Disasmfield[d_nr].befehl := Disasmline;
  880.       IF (show_mode =  0) THEN   (* Adresse/Objektcode entfernen *)
  881.       BEGIN
  882.         Disasmfield[d_nr].befehl := copy(Disasmfield[d_nr].befehl,28,length(Disasmfield[d_nr].befehl)-27);
  883.         Disasmfield[d_nr].befehl := concat('       ',Disasmfield[d_nr].befehl);
  884.       END;         
  885.         inc(d_nr);
  886.       END;
  887.       FOR i :=1 TO d_nr DO
  888.       BEGIN
  889.           Set_Label(i);    (* Label einfügen *)
  890.     END;
  891.       Clear_Window;
  892.       i := 1;
  893.       mouse_off;
  894.       wind_update(BEG_UPDATE);
  895.       vst_color(vdiHandle,Blue);
  896.       WHILE (i <= d_nr) and (start_y <= yw + hw) DO   (* Druckschleife *)
  897.       BEGIN
  898.           Set_label_color(i);
  899.         v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  900.         inc(i);
  901.         number_lines := i;
  902.         start_y := start_y + 16;
  903.       vst_color(vdiHandle,Blue);
  904.       END;  
  905.       wind_update(END_UPDATE);
  906.       mouse_on;
  907.       vst_color(vdiHandle,Black);
  908.       save_window;
  909.   END
  910.   ELSE 
  911.   BEGIN
  912.     form_alert(1,'[1][ Noch keine Binärdatei | geladen ! ][ Hmmh ]');
  913.   END;
  914. END;
  915.  
  916. (**************************** Labeltabelle laden ***********************)
  917.  
  918. PROCEDURE Label_laden;
  919.  
  920. VAR name       : pfad; 
  921.     len_str    : string[4];
  922.     lablength  : longint;
  923.     Labfile : FILE OF BYTE;
  924.     
  925. (* Laden einer 64 KB Labeltabelle / Binärfiles von der Diskette *)
  926.  
  927. BEGIN
  928.   SelectFile(name,'LAB');
  929.   IF name <> '' THEN
  930.   BEGIN
  931.     ASSIGN(Labfile,name);               (* Datei zuordnen *)
  932.     RESET(Labfile);    
  933.     lablength := FileSize(Labfile);     (* Dateigröße holen *)
  934.     IF (lablength = 65536) THEN
  935.     BEGIN
  936.       blockread(Labfile,Labelfield,lablength);  (* Datei komplett laden *)
  937.       menu_icheck(mtree,LABCLEAR,0);            (* Label löschen unterdrücken *)
  938.       lab_clr := false;
  939.       close(Labfile);
  940.       IF filelength <> 0 THEN
  941.       BEGIN
  942.         Display;
  943.       END;  
  944.     END
  945.     ELSE
  946.     BEGIN
  947.       form_alert(1,'[1][ Dies ist keine | Labeltabelle ! ][ Gepennt ]');
  948.       close(Labfile);
  949.     END;
  950.   END;  
  951. END;
  952.  
  953. (**************************** Labeltabelle sichern ***********************)
  954.  
  955. PROCEDURE Label_sichern;
  956.  
  957. VAR name    : pfad; 
  958.     len_str : string[4];
  959.     Labfile : FILE OF BYTE;
  960.     
  961. (* Sichern einer 64 KB Labeltabelle / Binärfiles auf Diskette *)
  962.  
  963. BEGIN
  964.   IF filelength <> 0 THEN
  965.   BEGIN
  966.       SelectFile(name,'LAB');
  967.       IF name <> '' THEN
  968.       BEGIN
  969.         ASSIGN(Labfile,name);                   (* Datei zuordnen *)
  970.         REWRITE(Labfile);                       (* Datei schreiben *)
  971.         blockwrite(Labfile,Labelfield,65536);   (* Label komplett sichern *)
  972.         close(Labfile);
  973.       END;  
  974.     END
  975.     ELSE
  976.     BEGIN
  977.     form_alert(1,'[1][ Mind. 1x reassemblieren,| sonst macht das keinen | Sinn ! ][ Hmmh ]');
  978.     END;  
  979. END;
  980.  
  981. (*************************** Labeltabelle automatisch löschen ***********)
  982.  
  983. Procedure Lab_clear;
  984.  
  985. BEGIN
  986.   IF filelength <> 0 THEN
  987.   BEGIN
  988.    IF lab_clr THEN
  989.    BEGIN
  990.      menu_icheck(mtree,LABCLEAR,0);     (* Label löschen ausschalten *)
  991.      lab_clr := false;
  992.    END
  993.    ELSE
  994.    BEGIN
  995.      menu_icheck(mtree,LABCLEAR,1);     (* Label löschen einschalten *)
  996.      lab_clr := true;
  997.    END;
  998.     END
  999.     ELSE
  1000.     BEGIN
  1001.     form_alert(1,'[1][ Mind. 1x reassemblieren,| sonst macht das keinen | Sinn ! ][ Hmmh ]');
  1002.     END;     
  1003. END;
  1004.  
  1005. (*************** Dialog für Adresseingabe bearbeiten *******************)
  1006.  
  1007. PROCEDURE ADDRESS;              (* Hexzahlen aus Dialog holen *)
  1008.                                 (* und neu reassemblieren     *)
  1009. VAR res : integer;
  1010.     start     : Word;
  1011.     start_str : Hexa;
  1012.     len_str   : Hexa;
  1013.     off_str   : Hexa;
  1014.     
  1015. BEGIN
  1016.   hndl_form(SETSTART);
  1017.   rsrc_gaddr(R_TREE, SETSTART, tree);  (* Dialogadresse holen  *)
  1018.   GetPtext(tree,STARTADR,start_str);   (* Edit-Dialog auslesen *)
  1019.   GetPtext(tree,ENDADR,len_str);
  1020.   GetPtext(tree,FILEOFFSET,off_str);  
  1021.   WHILE length(start_str) < 4 DO (* Hexziffer 4stellig machen *)
  1022.   BEGIN
  1023.     start_str := '0' + start_str;
  1024.   END;
  1025.   WHILE length(off_str) < 4 DO   (* Hexziffer 4stellig machen *)
  1026.   BEGIN
  1027.     off_str := '0' + off_str;
  1028.   END;  
  1029.   val(len_str,startlen,res);     (* String in Zahl wandeln *)
  1030.   IF res <> 0 THEN               (* Schrotteingabe         *)
  1031.   BEGIN
  1032.     codestart := 0;
  1033.     SetPtext(tree,STARTADR,'1024');
  1034.   END;  
  1035.   Hex_in_Word(start,start_str);     (* Hex in Word *)
  1036.   codestart := start;
  1037.   Hex_in_Word(start,off_str);       (* Hex in Word *)
  1038.   file_offset := start;
  1039.   Display;
  1040. END;
  1041.  
  1042. (*************** Dialog für Adresseingabe bearbeiten *******************)
  1043.  
  1044. PROCEDURE JUMP_ADDRESS;         (* Hexzahlen aus Dialog holen *)
  1045.                                 (* und neu reassemblieren     *)
  1046. VAR res,j       : Integer;
  1047.     start       : Word;
  1048.     start_str   : Hexa;
  1049.     exitbutton  : Integer;
  1050.     start_x,start_y : Integer;
  1051.     xw,yw,bw,hw :Integer;
  1052.     
  1053. BEGIN
  1054.   exitbutton := hndl_form(JMPADDR);
  1055.   IF exitbutton = JUMP THEN
  1056.   BEGIN
  1057.     rsrc_gaddr(R_TREE, JMPADDR, tree);   (* Dialogadresse holen  *)
  1058.     GetPtext(tree,JADDRESS,start_str);   (* Edit-Dialog auslesen *)
  1059.     WHILE length(start_str) < 4 DO (* Hexziffer 4stellig machen *)
  1060.     BEGIN
  1061.       start_str := '0' + start_str;
  1062.     END;
  1063.     Hex_in_Word(start,start_str);     (* Hex in Word *)
  1064.     IF d_nr > 1 THEN
  1065.     BEGIN
  1066.       IF (disasmfield[1].adr <= start) and (disasmfield[d_nr-1].adr >= start) THEN
  1067.       BEGIN
  1068.         j := 1;
  1069.         WHILE (disasmfield[j].adr <= start) DO
  1070.         BEGIN
  1071.           inc(j); 
  1072.         END;
  1073.         IF (disasmfield[j].adr = start) THEN
  1074.         BEGIN
  1075.            act_d_nr := j;
  1076.         END
  1077.         ELSE
  1078.         BEGIN
  1079.            act_d_nr := j - 1;         
  1080.         END;
  1081.       END;
  1082.     END;
  1083.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  1084.     start_x := xw + 16;
  1085.     start_y := yw + 16;    
  1086.       Clear_Window;
  1087.       mouse_off;
  1088.       wind_update(BEG_UPDATE);
  1089.       vst_color(vdiHandle,Blue);
  1090.       j := act_d_nr;
  1091.       WHILE (j <= d_nr) and (start_y <= yw + hw) DO   (* Druckschleife *)
  1092.       BEGIN
  1093.           Set_label_color(j);
  1094.         v_gtext(vdiHandle,start_x,start_y,Disasmfield[j].befehl);
  1095.         inc(j);
  1096.         start_y := start_y + 16;
  1097.       vst_color(vdiHandle,Blue);
  1098.       END;  
  1099.       wind_update(END_UPDATE);
  1100.       mouse_on;
  1101.       vst_color(vdiHandle,Black);
  1102.       save_window;
  1103.     END;  
  1104. END;
  1105.  
  1106. (********************* Datei / Drucker-Ausgabe ************************)
  1107.  
  1108. PROCEDURE ASCIIOUT(VAR kanal:text;printflag:byte);   
  1109.  
  1110. VAR j: integer;
  1111.     c_start, c_end : Hexa;
  1112.     
  1113. (* Ausgabe 60 Zeilen/Seite in Datei und auf Drucker *)
  1114.  
  1115. BEGIN                         (* Drucker/Datei Ausgabe nur möglich, *)
  1116.   IF d_nr > 1  THEN           (* wenn bereits reassembliert wurde.  *)
  1117.   BEGIN                        
  1118.     IF show_mode = 1 THEN
  1119.     BEGIN                            
  1120.       c_start := copy(disasmfield[1].befehl,3,4);
  1121.       c_end   := copy(disasmfield[d_nr-1].befehl,3,4);
  1122.     END
  1123.     ELSE
  1124.     BEGIN
  1125.         Makehexadr(c_start,Disasmfield[1].adr); 
  1126.         Makehexadr(c_end,Disasmfield[d_nr-1].adr);     
  1127.     END;
  1128.     rewrite(kanal);           (* Schreibkanal öffnen                *)
  1129.     writeln(kanal,'   ; INTEL 8080/85 REASSEMBLER by Jens Schulz 1994');
  1130.     writeln(kanal,'   ; for ATARI ST/TT/FALCON computers');
  1131.     writeln(kanal);
  1132.     writeln(kanal,'   ; Codestart : $',c_start,'   Codeend : $',c_end);
  1133.     writeln(kanal);
  1134.     FOR j := 1 TO d_nr DO
  1135.     BEGIN
  1136.       writeln(kanal,'  ',Disasmfield[j].Befehl);
  1137.       IF (j mod 60 = 0) THEN  (* Seitenvorschub *)
  1138.       BEGIN
  1139.         IF printflag = 1 THEN
  1140.         BEGIN
  1141.           writeln(kanal,chr(12));  (* Formfeed *)
  1142.         END;
  1143.       END;  
  1144.     END;
  1145.     close(kanal);                    (* Kanal schliessen      *)
  1146.     IF printflag = 0 THEN
  1147.     BEGIN
  1148.       menu_icheck(mtree,FILEOUT,1);  (* Dateihäkchen an       *)
  1149.       menu_icheck(mtree,PRTOUT,0);   (* Druckerhäkchen aus    *)    
  1150.       menu_icheck(mtree,DISPOUT,0);  (* Bildschirmhäkchen aus *) 
  1151.     END
  1152.     ELSE
  1153.     BEGIN
  1154.       menu_icheck(mtree,PRTOUT,1);   (* Druckerhäkchen an     *)
  1155.       menu_icheck(mtree,DISPOUT,0);  (* Bildschirmhäkchen aus *)
  1156.       menu_icheck(mtree,FILEOUT,0);  (* Dateihäkchen aus      *)      
  1157.     END;      
  1158.   END
  1159.   ELSE
  1160.   BEGIN
  1161.     form_alert(1,'[1][ Fehler, bitte vorher | 1x reassemblieren ! ][ Okay ]')
  1162.   END;
  1163. END;
  1164.  
  1165. (***************************** Datei-Ausgabe ***************************)
  1166.  
  1167. PROCEDURE DATEI;
  1168.  
  1169. {Reassemblieren auf Diskette als Textfile }
  1170.  
  1171. VAR kanal : text;
  1172.     name  : pfad;
  1173.  
  1174. BEGIN
  1175.   IF d_nr > 1 THEN
  1176.   BEGIN
  1177.     SelectFile(name,'ASC');
  1178.     IF name <> '' THEN    
  1179.     BEGIN
  1180.       assign(kanal,name);
  1181.       asciiout(kanal,0);
  1182.     END;  
  1183.   END
  1184.   ELSE
  1185.   BEGIN
  1186.     form_alert(1,'[1][ Fehler, bitte vorher | 1x reassemblieren ! ][ Okay ]')
  1187.   END;
  1188. END;
  1189.  
  1190. (**************************Drucker-Ausgabe ******************************)
  1191.  
  1192. PROCEDURE DRUCKER;
  1193.  
  1194. VAR kanal : text;        (* Ausgabe auf Drucker, LST-Kanal öffnen *)
  1195.  
  1196. BEGIN
  1197.   assign(kanal,'PRN');
  1198.   ASCIIOUT(kanal,1);
  1199. END;
  1200.  
  1201. (********************** Umschalter 8080 oder 8085-Code *******************)
  1202.  
  1203. PROCEDURE MODUS(mode:byte);
  1204.  
  1205. { Prozessor 8080 oder 8085 festlegen
  1206.   8085 besitzt 2 Befehle mehr, nämlich SIM und RIM }
  1207.  
  1208. BEGIN
  1209.   IF mode = 0 THEN
  1210.   BEGIN
  1211.     proztype := '8080';
  1212.     m[32] := '4DEFB ';
  1213.     m[48] := '4DEFB ';
  1214.     menu_icheck(mtree,SET8080,1);       (* Häkchen setzen *)
  1215.     menu_icheck(mtree,SET8085,0);
  1216.   END
  1217.   ELSE
  1218.   BEGIN
  1219.     proztype := '8085';
  1220.     m[32] := '0RIM';
  1221.     m[48] := '0SIM';
  1222.     menu_icheck(mtree,SET8085,1);       (* Häkchen setzen *)
  1223.     menu_icheck(mtree,SET8080,0);    
  1224.   END;
  1225. END;
  1226.  
  1227. (******************** Adressen/Objektcode einblenden ******************)
  1228.  
  1229. Procedure Objcode_show;
  1230.  
  1231. BEGIN
  1232.   IF show_mode = 0 THEN   (* Adressen/Objekt einblenden *)
  1233.   BEGIN
  1234.     show_mode := 1;
  1235.     menu_icheck(mtree,ADRCODE,1);
  1236.         winfo :='   Adresse  Label   Code      Mnemonics'#0;
  1237.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0)
  1238.  END     
  1239.  ELSE     
  1240.  BEGIN
  1241.     show_mode := 0;
  1242.     menu_icheck(mtree,ADRCODE,0);
  1243.         winfo :='  Label   Mnemonics'#0;
  1244.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
  1245.  END;
  1246.  Display;
  1247. END;
  1248.  
  1249. (*****  Initialisierung der Mnemonic-Tabelle für Code $00 - $FF *****)
  1250.  
  1251. PROCEDURE LOADDATA ;
  1252.  
  1253. { 1. Zeichen = Adressierungsart
  1254.                0 = implizite Adressierung
  1255.                1 = absolute  Adressierung
  1256.                2 = immediate Adressierung 8- bit Konstante
  1257.                3 = immediate Adressierung 16-bit Konstante
  1258.                4 = DATA Element
  1259.  
  1260.   ab 2.Zeichen Mnemonics-Abkürzung
  1261.   unerlaubte Codes werden als DATA  #Code resassembliert
  1262. }
  1263.  
  1264. BEGIN
  1265.   proztype := '8085';
  1266.   M[0] :='0NOP';      M[1] :='3LXI  B,';  M[2] :='0STAX B';    M[3] :='0INX  B';
  1267.   M[4] :='0INC  R';   M[5] :='0DCR  B';   M[6] :='2MVI  B,';   M[7] :='0RLC';
  1268.   M[8] :='4DEFB ';    M[9] :='0DAD  B';   M[10]:='0LDAX B';    M[11]:='0DCX  B';
  1269.   M[12]:='0INR  C';   M[13]:='0DCR  C';   M[14]:='2MVI  C,';   M[15]:='0RRC';
  1270.   M[16]:='4DEFB ';    M[17]:='3LXI  D,';  M[18]:='0STAX D';    M[19]:='0INX  D';
  1271.   M[20]:='0INR  D';   M[21]:='0DCR  D';   M[22]:='2MVI  D,';   M[23]:='0RAL';
  1272.   M[24]:='4DEFB ';    M[25]:='0DAD  D';   M[26]:='0LDAX D';    M[27]:='0DCX  D';
  1273.   M[28]:='0INR  E';   M[29]:='0DCR  E';   M[30]:='2MVI  E,';   M[31]:='0RAR';
  1274.   M[32]:='0RIM';      M[33]:='3LXI  H,';  M[34]:='1SHLD ';     M[35]:='0INX  H';
  1275.   M[36]:='0INR  H';   M[37]:='0DCR  H';   M[38]:='2MVI  H,';   M[39]:='0DAA';
  1276.   M[40]:='4DEFB ';    M[41]:='0DAD  H';   M[42]:='1LHLD ';     M[43]:='0DCX  H';
  1277.   M[44]:='0INR  L';   M[45]:='0DCR  L';   M[46]:='2MVI  L,';   M[47]:='0CMA';
  1278.   M[48]:='0SIM';      M[49]:='3LXI  SP,'; M[50]:='1STA  ';     M[51]:='0INX  SP';
  1279.   M[52]:='0INR  M';   M[53]:='0DCR  M';   M[54]:='2MVI  M,';    M[55]:='0STC';
  1280.   M[56]:='4DEFB ';    M[57]:='0DAD  SP';  M[58]:='1LDA  ';      M[59]:='0DCX  SP';
  1281.   M[60]:='0INR  A';    M[61]:='0DCR  A';   M[62]:='2MVI  A,';   M[63]:='0CMC';
  1282.   M[64]:='0MOV  B,B';  M[65]:='0MOV  B,C'; M[66]:='0MOV  B,D';  M[67]:='0MOV  B,E';
  1283.   M[68]:='0MOV  B,H';  M[69]:='0MOV  B,L'; M[70]:='0MOV  B,M';  M[71]:='0MOV  B,A';
  1284.   M[72]:='0MOV  C,B';  M[73]:='0MOV  C,C'; M[74]:='0MOV  C,D';  M[75]:='0MOV  C,E';
  1285.   M[76]:='0MOV  C,H';  M[77]:='0MOV  C,L'; M[78]:='0MOV  C,M';  M[79]:='0MOV  C,A';
  1286.   M[80]:='0MOV  D,B';  M[81]:='0MOV  D,C'; M[82]:='0MOV  D,D';  M[83]:='0MOV  D,E';
  1287.   M[84]:='0MOV  D,H';  M[85]:='0MOV  D,L'; M[86]:='0MOV  D,M';  M[87]:='0MOV  D,A';
  1288.   M[88]:='0MOV  E,B';  M[89]:='0MOV  E,C'; M[90]:='0MOV  E,D';  M[91]:='0MOV  E,E';
  1289.   M[92]:='0MOV  E,H';  M[93]:='0MOV  E,L'; M[94]:='0MOV  E,M';  M[95]:='0MOV  E,A';
  1290.   M[96]:='0MOV  H,B';  M[97]:='0MOV  H,C'; M[98]:='0MOV  H,D';  M[99]:='0MOV  H,E';
  1291.   M[100]:='0MOV  H,H'; M[101]:='0MOV  H,L';M[102]:='0MOV  H,M'; M[103]:='0MOV  H,A';
  1292.   M[104]:='0MOV  L,B'; M[105]:='0MOV  L,C';M[106]:='0MOV  L,D'; M[107]:='0MOV  L,E';
  1293.   M[108]:='0MOV  L,H'; M[109]:='0MOV  L,L';M[110]:='0MOV  L,M'; M[111]:='0MOV  L,A';
  1294.   M[112]:='0MOV  M,B'; M[113]:='0MOV  M,C';M[114]:='0MOV  M,D'; M[115]:='0MOV  M,E';
  1295.   M[116]:='0MOV  M,H'; M[117]:='0MOV  M,L';M[118]:='0HLT';      M[119]:='0MOV  M,A';
  1296.   M[120]:='0MOV  A,B'; M[121]:='0MOV  A,C';M[122]:='0MOV  A,D'; M[123]:='0MOV  A,E';
  1297.   M[124]:='0MOV  A,H'; M[125]:='0MOV  A,L';M[126]:='0MOV  A,M'; M[127]:='0MOV  A,A';
  1298.   M[128]:='0ADD  B';   M[129]:='0ADD  C';  M[130]:='0ADD  D';   M[131]:='0ADD  E';
  1299.   M[132]:='0ADD  H';   M[133]:='0ADD  L';  M[134]:='0ADD  M';   M[135]:='0ADD  A';
  1300.   M[136]:='0ADC  B';   M[137]:='0ADC  C';  M[138]:='0ADC  D';   M[139]:='0ADC  E';
  1301.   M[140]:='0ADC  H';   M[141]:='0ADC  L';  M[142]:='0ADC  M';   M[143]:='0ADC  A';
  1302.   M[144]:='0SUB  B';   M[145]:='0SUB  C';  M[146]:='0SUB  D';   M[147]:='0SUB  E';
  1303.   M[148]:='0SUB  H';   M[149]:='0SUB  L';  M[150]:='0SUB  M';   M[151]:='0SUB  A';
  1304.   M[152]:='0SBB  B';   M[153]:='0SBB  C';  M[154]:='0SBB  D';   M[155]:='0SBB  E';
  1305.   M[156]:='0SBB  H';   M[157]:='0SBB  L';  M[158]:='0SBB  M';   M[159]:='0SBB  A';
  1306.   M[160]:='0ANA  B';   M[161]:='0ANA  C';  M[162]:='0ANA  D';   M[163]:='0ANA  E';
  1307.   M[164]:='0ANA  H';   M[165]:='0ANA  L';  M[166]:='0ANA  M';   M[167]:='0ANA  A';
  1308.   M[168]:='0XRA  B';   M[169]:='0XRA  C';  M[170]:='0XRA  D';   M[171]:='0XRA  E';
  1309.   M[172]:='0XRA  H';   M[173]:='0XRA  L';  M[174]:='0XRA  M';   M[175]:='0XRA  A';
  1310.   M[176]:='0ORA  B';   M[177]:='0ORA  C';  M[178]:='0ORA  D';   M[179]:='0ORA  E';
  1311.   M[180]:='0ORA  H';   M[181]:='0ORA  L';  M[182]:='0ORA  M';   M[183]:='0ORA  A';
  1312.   M[184]:='0CMP  B';   M[185]:='0CMP  C';  M[186]:='0CMP  D';   M[187]:='0CMP  E';
  1313.   M[188]:='0CMP  H';   M[189]:='0CMP  L';  M[190]:='0CMP  M';   M[191]:='0CMP  A';
  1314.   M[192]:='0RNZ';      M[193]:='0POP  B';  M[194]:='1JNZ  ';    M[195]:='1JMP  ';
  1315.   M[196]:='1CNZ  ';    M[197]:='0PUSH B';  M[198]:='2ADI  ';    M[199]:='0RST  0';
  1316.   M[200]:='0RZ';       M[201]:='0RET';     M[202]:='1JZ   ';    M[203]:='4DEFB ';
  1317.   M[204]:='1CZ   ';    M[205]:='1CALL ';   M[206]:='2ACI  ';    M[207]:='0RST  1';
  1318.   M[208]:='0RNC';      M[209]:='0POP  D';  M[210]:='1JNC  ';    M[211]:='2OUT  ';
  1319.   M[212]:='1CNC  ';    M[213]:='0PUSH D';  M[214]:='2SUI  ';    M[215]:='0RST  2';
  1320.   M[216]:='0RC';       M[217]:='4DEFB ';   M[218]:='1JC   ';    M[219]:='2IN   ';
  1321.   M[220]:='1CC   ';    M[221]:='4DEFB ';   M[222]:='2SBI  ';    M[223]:='0RST  3';
  1322.   M[224]:='0RPO';      M[225]:='0POP  H';  M[226]:='1JPO  ';    M[227]:='0XTHL';
  1323.   M[228]:='1CPO  ';    M[229]:='0PUSH H';  M[230]:='2ANI  ';    M[231]:='0RST  4';
  1324.   M[232]:='0RPE';      M[233]:='0PCHL ';   M[234]:='1JPE  ';    M[235]:='0XCHG';
  1325.   M[236]:='1CPE  ';    M[237]:='4DEFB ';   M[238]:='2XRI  ';    M[239]:='0RST  5';
  1326.   M[240]:='0RP';       M[241]:='0POP  PSW';M[242]:='1JP   ';    M[243]:='0DI';
  1327.   M[244]:='1CP   ';    M[245]:='0PUSH PSW';M[246]:='2ORI  ';    M[247]:='0RST  6';
  1328.   M[248]:='0RM';       M[249]:='0SPHL ';   M[250]:='1JM   ';    M[251]:='0EI';
  1329.   M[252]:='1CM   ';    M[253]:='4DEFB ';   M[254]:='2CPI  ';    M[255]:='0RST  7';
  1330. END;
  1331.  
  1332. (*********************** GEM-Event-Schleife ****************************)
  1333.  
  1334. Procedure event_loop(VAR nachr,typ_nachricht:integer);
  1335.     
  1336. VAR msgbuff : array_8;
  1337.     clip    : array_4;
  1338.     dummy   : integer;
  1339.     i,j     : integer;
  1340.     start_x : integer;
  1341.     start_y : integer;
  1342.     was_liegt_an : integer;
  1343.  
  1344. BEGIN
  1345.   REPEAT
  1346.     was_liegt_an := evnt_multi( MU_MESAG or MU_KEYBD, 0, 0, 0, 0, 0,
  1347.                     0, 0, 0, 0, 0, 0, 0, 0,
  1348.                     msgbuff,    0,0,
  1349.                     dummy, dummy, dummy,
  1350.                     dummy, key, dummy );
  1351.  
  1352.     IF was_liegt_an = MU_MESAG THEN   (* eine Message liegt an *)
  1353.     BEGIN
  1354.         case msgbuff[0] of
  1355.            WM_REDRAW:    if msgbuff[3]=whandle then      (* Fenster restaurieren *)
  1356.                             BEGIN
  1357.                               redrawwindow;
  1358.                             END;  
  1359.            WM_TOPPED:    if msgbuff[3]=whandle then      (* Fenster toppen *)
  1360.                             BEGIN
  1361.                               wind_update(BEG_UPDATE);
  1362.                         wind_set(whandle,WF_TOP,0,0,0,0);
  1363.                         wind_update(END_UPDATE);
  1364.                       END;  
  1365.            WM_CLOSED:    if msgbuff[3]=whandle then      (* Fenster schliessen *)
  1366.                                 BEGIN
  1367.                                     button := form_alert(1,'[2][ INTEL 8080/85 Reassembler | beenden ? ][ Ja | Nein ]');
  1368.                                     if button = 1 THEN
  1369.                                     BEGIN
  1370.                                       ENDE := true;
  1371.                                     END;  
  1372.                                 END;
  1373.              WM_MOVED:    if msgbuff[3]=whandle then       (* Fenster verschoben *)
  1374.                             BEGIN
  1375.                               wind_update(BEG_UPDATE);
  1376.                               IF (msgbuff[4]+400) > max_x THEN  (* Fenster soll   *)
  1377.                               BEGIN                             (* immer komplett *)
  1378.                                 msgbuff[4] := max_x-400;        (* auf Screen     *)
  1379.                               END;                              (* bleiben        *)
  1380.                               IF (msgbuff[5] < 19) THEN
  1381.                               BEGIN
  1382.                                  msgbuff[5] := 19;
  1383.                               END;
  1384.                               wind_get(whandle,WF_CURRXYWH,x,y,w,h);
  1385.                               IF msgbuff[5] + h > max_y + 19 THEN
  1386.                               BEGIN
  1387.                                 msgbuff[5] := 19 + max_y - h;  (* nicht über unteren Rand *)
  1388.                               END;
  1389.                               BEGIN   
  1390.                                     wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],msgbuff[6],msgbuff[7]);
  1391.                                   END;   
  1392.                                   redrawwindow;
  1393.                                 wind_update(END_UPDATE);
  1394.                               END;
  1395.                               
  1396.                 WM_SIZED: IF msgbuff[3] = whandle THEN
  1397.                           BEGIN
  1398.                             wind_update(BEG_UPDATE);
  1399.                             IF msgbuff[6] <> 400 THEN
  1400.                             BEGIN
  1401.                                msgbuff[6] := 400;  (* feste Breite);
  1402.                             END;   
  1403.                             IF msgbuff[7] < 130 THEN
  1404.                             BEGIN
  1405.                                msgbuff[7] := 130;  (* minimale Höhe *);
  1406.                             END; 
  1407.                             wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],msgbuff[6],msgbuff[7]);
  1408.                           wind_get(whandle,WF_WORKXYWH,x,y,w,h);
  1409.                           clip[0]:= x; clip[1]:= y;
  1410.                             clip[2]:= x + w - 1; clip[3]:= y + h - 1;
  1411.                             vs_clip(vdiHandle,1,clip);
  1412.                         clear_window;        
  1413.                       start_x := x + 16;
  1414.                       start_y := y + 16;
  1415.                       vst_color(vdiHandle,blue);
  1416.                       i := act_d_nr;
  1417.                       j := 1;
  1418.                         WHILE start_y <= y + h DO   (* Zeilenanzahl *)
  1419.                         BEGIN
  1420.                           inc(j);
  1421.                           number_lines := j;
  1422.                           start_y := start_y + 16;
  1423.                         END;                
  1424.                         start_y := y + 16;                 
  1425.                         WHILE (i <= d_nr) and (start_y <= y + h) DO   (* Druckschleife *)
  1426.                         BEGIN
  1427.                           Set_label_color(i);
  1428.                           v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  1429.                           inc(i);
  1430.                           start_y := start_y + 16;
  1431.                         vst_color(vdiHandle,Blue);
  1432.                         END;                       
  1433.                       save_window;
  1434.                       wind_update(END_UPDATE);  
  1435.                           END;
  1436.               
  1437.               WM_ARROWED: IF msgbuff[3]=whandle THEN     (* zeilenweise scrollen *)
  1438.                             BEGIN
  1439.                               wind_update(BEG_UPDATE);
  1440.                               CASE msgbuff[4] OF
  1441.                                 WA_UPLINE : Scroll_line_up;
  1442.                                 WA_DNLINE : Scroll_line_down;
  1443.                               END;   
  1444.                               wind_update(END_UPDATE);
  1445.                             END;
  1446.                                    
  1447.                  WM_VSLID:  IF msgbuff[3]=whandle THEN    (* Slider-Scrolling *)
  1448.                             BEGIN
  1449.                               wind_update(BEG_UPDATE);
  1450.                       slider_move(msgbuff[4]);
  1451.                               wind_update(END_UPDATE);
  1452.                             END;              
  1453.          END;
  1454.     END;
  1455.   UNTIL (msgbuff[0] = MN_selected) or (was_liegt_an = MU_KEYBD) or ENDE;
  1456.   IF (msgbuff[0] = MN_selected) THEN
  1457.   BEGIN
  1458.      menu_tnormal( mtree, msgbuff[3], 1);
  1459.      nachr := msgbuff[4];
  1460.   END;   
  1461.   IF (was_liegt_an = MU_KEYBD) THEN
  1462.   BEGIN
  1463.      nachr := key;
  1464.   END;   
  1465.   typ_nachricht := was_liegt_an;
  1466. END;
  1467.  
  1468. PROCEDURE main;
  1469.  
  1470. VAR
  1471.   wahl1 : integer;
  1472.   
  1473. BEGIN
  1474.     show_mode := 1;
  1475.     ENDE := FALSE;
  1476.     error:=rsrc_load(Resourcefile);
  1477.     IF error=0 THEN
  1478.         form_alert(1,'[1][ Fehler beim Laden | der RSC-Datei ][ Pech ]')
  1479.     ELSE
  1480.     BEGIN
  1481.         rsrc_gaddr(R_TREE, DISASM85, mtree);
  1482.         mouse_off;
  1483.         menu_bar( mtree, 1 );
  1484.         mouse_on;
  1485.         graf_mouse( ARROW, NIL );
  1486.         path := '';
  1487.           Dgetpath( path, 0 );                  (* Pfad holen    *)
  1488.           path := FExpand( path )+'\*.';        (* Pfad ergänzen *)
  1489.         IF pos('\\',path) > 0 THEN            (* Doppel-Backslash killen *)    
  1490.         BEGIN                                 (* z.B. bei Laufwerk A:    *)
  1491.           delete(path,pos('\\',path),1)
  1492.         END;          
  1493.         hndl_form(INFOBOX);
  1494.         REPEAT
  1495.             event_loop(wahl1,typ_nachricht);
  1496.             IF ENDE THEN
  1497.             BEGIN
  1498.               wahl1 := QUIT;
  1499.             END;
  1500.             IF typ_nachricht = MU_MESAG THEN  (* Menüauswahl *)
  1501.             BEGIN
  1502.               CASE wahl1 OF
  1503.                 SHOWINFO : hndl_form(INFOBOX);
  1504.                 LOADCODE : Laden;
  1505.                 ADRCODE  : Objcode_Show;
  1506.                 DISASM   : Display;
  1507.                 SETADR   : ADDRESS;
  1508.                 JUMPADR  : JUMP_ADDRESS;
  1509.                 SET8080  : Modus(0); 
  1510.                 SET8085  : Modus(1);
  1511.                 DISPOUT  : Display;
  1512.                 PRTOUT   : Drucker;
  1513.                 FILEOUT  : Datei;  
  1514.                 LABLOAD  : Label_laden;
  1515.                 LABSAVE  : Label_sichern;
  1516.                 LABCLEAR : Lab_clear;
  1517.               END;
  1518.             END  
  1519.             ELSE
  1520.             BEGIN
  1521.               CASE wahl1 OF
  1522.                 9740  : Laden;  (* Tastaturauswahl *)
  1523.                 7681  : Objcode_Show;
  1524.                 15104 : Display;
  1525.                 7955  : ADDRESS;
  1526.                 9226  : JUMP_ADDRESS;
  1527.                 15360 : Modus(0); 
  1528.                 15616 : Modus(1);
  1529.                 12290 : Display;
  1530.                 6416  : Drucker;
  1531.                 8454  : Datei;
  1532.                 5140  : Label_laden;
  1533.                 12558 : Label_sichern;
  1534.                 11779 : Lab_clear;
  1535.                 18432 : BEGIN
  1536.                                   wind_update(BEG_UPDATE); (* Cursor hoch *)
  1537.                                   Scroll_line_up;
  1538.                                   wind_update(END_UPDATE);
  1539.                                 END;
  1540.                         20480 : BEGIN
  1541.                                   wind_update(BEG_UPDATE);  (* Cursor tief *)
  1542.                                   Scroll_line_down;
  1543.                                   wind_update(END_UPDATE);
  1544.                                 END;                          
  1545.                 4113  : wahl1 := QUIT;                             
  1546.               END;
  1547.             END;  
  1548.         UNTIL wahl1=QUIT;
  1549.         mouse_off;
  1550.         menu_bar( mtree, 0 );
  1551.         mouse_on;
  1552.         wind_close(whandle);
  1553.         wind_delete(whandle);
  1554.         rsrc_free( );
  1555.         IF error=0 THEN
  1556.             form_alert(1,'[1][ Fehler bei der | Freigabe des RSC-Speichers ][ Pech ]');
  1557.     END;
  1558. END;
  1559.  
  1560. BEGIN
  1561.     file_offset := 0;   (* Initialisierung der Adresszähler usw. *)
  1562.     filelength := 0;
  1563.     codestart := 0;
  1564.     d_nr := 0;
  1565.     lab_clr := true;
  1566.     IF initgem=true THEN
  1567.     BEGIN
  1568.       wind_get(0,WF_CURRXYWH,    x, y, w, h);
  1569.       IF h < 399 THEN
  1570.       BEGIN
  1571.         form_alert(1,'[1][ Bildschirm-Auflösung | ist zu klein ! | Mindestens 640 * 400 ! ][ Okay ]');
  1572.       END
  1573.       ELSE
  1574.       BEGIN 
  1575.         bufferlen := trunc(get_bitplanes * 400.0 * h + 256.0) div 8; (* Gleitkomma, sonst Müll *)
  1576.         screen_buffer := malloc(bufferlen);  (* Fensterspeicher reservieren *)
  1577.         LOADDATA ;
  1578.         Open_window;   
  1579.         main;
  1580.         mfree(screen_buffer);  (* Speicher freigeben *)
  1581.       END;
  1582.         ExitGEM;
  1583.     END;  
  1584. END.
  1585.  
  1586.